home *** CD-ROM | disk | FTP | other *** search
/ Developer Helper 1: Phil & Dave's Excellent CD / Excellent CD HFS.raw / Moof / Goodies / HyperCard Goodies / HyperCard Dev. ToolKit / Video.Drivers / HitachiVideo.p next >
Text File  |  1987-08-17  |  7KB  |  304 lines
  1. {$R-}
  2. {$D+}
  3. (*
  4.     HitachiVideo -- a HyperCard user-defined command to drive 
  5.     a Hitachi 9550 laserdisc player.  
  6.     ©Apple Computer, Inc. 1987
  7.     All Rights Reserved.
  8.  
  9.  
  10.     To compile and link this file using Macintosh Programmer's Workshop
  11.     (HyperXCmd.p and XCmdGlue.inc must be accessible).
  12.  
  13.     pascal -w HitachiVideo.p
  14.     link -m ENTRYPOINT -o HyperCommands -rt XCMD=12 -sn Main=HitachiVideo ∂
  15.       HitachiVideo.p.o "{MPW}"Libraries:interface.o
  16.  
  17.     then use ResEdit to copy the resulting XCMD from HyperCommands
  18.     and paste it into the Home stack, or your own stack.
  19.     (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
  20. *)
  21.  
  22. {$S HitachiVideo }     { Segment name must be the same as the command name. }
  23.  
  24. UNIT DummyUnit;
  25.  
  26. INTERFACE
  27.  
  28.    USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
  29.     
  30. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  31.     
  32. IMPLEMENTATION
  33.  
  34. TYPE Str19 = String[19];
  35.      Str31 = String[31];
  36.  
  37. PROCEDURE HitachiVideo(paramPtr: XCmdPtr);                        FORWARD;
  38.  
  39.    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  40.    { entry point cannot have local procs, but forward routines can }
  41.    BEGIN
  42.      HitachiVideo(paramPtr);
  43.    END;
  44.  
  45.    PROCEDURE HitachiVideo(paramPtr: XCmdPtr);
  46.    VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
  47.        tempStr: Str255;
  48.        refNum: INTEGER;
  49.        err: INTEGER;
  50.        params: ARRAY[1..32] OF Str19;
  51.  
  52.      {$I XCmdGlue.inc }
  53.       
  54.      PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
  55.      BEGIN
  56.        paramPtr^.returnValue := PasToZero(errMsg);
  57.        EXIT(HitachiVideo);
  58.      END;
  59.             
  60.      PROCEDURE OpenSerial;
  61.      VAR handShake: SerShk;
  62.          baudRate: INTEGER;
  63.      BEGIN
  64.        baudRate := 9600;
  65.        { for now, use modem port so we don't mess with AppleTalk }
  66.        err := FSOpen('.AOUT',0,refNum);
  67.        IF err = 0 THEN 
  68.          BEGIN
  69.            WITH handShake DO
  70.              BEGIN
  71.                fXon := 1;
  72.                fCTS := 1;
  73.                xon  := CHR(17);
  74.                xoff := CHR(19);
  75.                errs := 0;
  76.                evts := 0;
  77.                fInx := 0;
  78.              END;
  79.            err := SerHShake(refNum,handShake);
  80.            IF err = 0 THEN 
  81.              err := Control(refNum,13,@baudRate);
  82.          END;
  83.      END;
  84.      
  85.      
  86.      PROCEDURE CloseSerial;
  87.      BEGIN
  88.        err := FSClose(refNum);
  89.      END;
  90.      
  91.      
  92.      PROCEDURE SendCommand(cmd: Str255);
  93.      VAR count: LongInt;
  94.      BEGIN
  95.        count := Length(cmd);
  96.        err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
  97.      END;
  98.      
  99.      FUNCTION Concat(str1, str2, str3: Str255): Str255;
  100.      VAR result: Str255;
  101.          resultLen: INTEGER;
  102.          charNum: INTEGER;
  103.      BEGIN
  104.        result := '';
  105.        resultLen := 0;
  106.        FOR charNum := 1 TO Length(str1) DO
  107.          BEGIN
  108.            resultLen := resultLen + 1;
  109.            result[resultLen] := str1[charNum];
  110.          END;
  111.        FOR charNum := 1 TO Length(str2) DO
  112.          BEGIN
  113.            resultLen := resultLen + 1;
  114.            result[resultLen] := str2[charNum];
  115.          END;
  116.        FOR charNum := 1 TO Length(str3) DO
  117.          BEGIN
  118.            resultLen := resultLen + 1;
  119.            result[resultLen] := str3[charNum];
  120.          END;
  121.       result[0] := CHR(resultLen);
  122.       Concat := result;
  123.      END;
  124.      
  125.      
  126.      PROCEDURE GetMessage;     
  127.      VAR paramNum, charNum: INTEGER;
  128.          msgChar: CHAR;
  129.      BEGIN
  130.        { convert params to pascal strings }
  131.        FOR paramNum := 1 TO paramPtr^.paramCount DO
  132.          BEGIN
  133.            tempStr := params[paramNum];
  134.            ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
  135.            { force all chars to lower case }
  136.            FOR charNum := 1 TO Length(tempStr) DO
  137.              BEGIN
  138.                msgChar := tempStr[charNum];
  139.                IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
  140.                  tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
  141.              END;
  142.            params[paramNum] := tempStr;
  143.          END;
  144.      END;
  145.      
  146.        
  147.      FUNCTION Contains(target: Str255): BOOLEAN;
  148.      VAR offset: INTEGER;     
  149.      
  150.        FUNCTION Match(which: INTEGER): BOOLEAN;
  151.        VAR index: INTEGER;
  152.        BEGIN
  153.          Match := TRUE;
  154.          FOR index := 1 TO Length(target) DO
  155.            IF index > Length(params[which]) THEN 
  156.              BEGIN
  157.                Match := FALSE;  { ran off the end }
  158.                EXIT(Match);
  159.              END
  160.            ELSE IF target[index] <> params[which][index] THEN
  161.              BEGIN
  162.                Match := FALSE;  { hit a wrong char }
  163.                EXIT(Match);
  164.              END;
  165.        END;
  166.        
  167.      BEGIN
  168.        Contains := FALSE;
  169.        FOR offset := 1 TO paramPtr^.paramCount DO
  170.          IF Match(offset) THEN
  171.            BEGIN
  172.              Contains := TRUE;
  173.              EXIT(Contains);
  174.            END;
  175.      END;
  176.      
  177.      
  178.      FUNCTION GetDigit(digit: CHAR): Str255;
  179.      BEGIN
  180.        CASE digit OF
  181.          '0': GetDigit := '0'; { this is doing a type conversion }
  182.          '1': GetDigit := '1'; { from CHAR to Str255 }
  183.          '2': GetDigit := '2';
  184.          '3': GetDigit := '3';
  185.          '4': GetDigit := '4';
  186.          '5': GetDigit := '5';
  187.          '6': GetDigit := '6';
  188.          '7': GetDigit := '7';
  189.          '8': GetDigit := '8';
  190.          '9': GetDigit := '9';
  191.        END;
  192.      END;
  193.   
  194.   
  195.      FUNCTION GetInteger: Str255;
  196.      { get an integer in Pioneer format }
  197.      VAR which, digitLoc, charVal: INTEGER;
  198.          intStr:            Str255;
  199.      BEGIN
  200.        intStr := '';
  201.        FOR which := 1 TO paramPtr^.paramCount DO
  202.          BEGIN
  203.            charVal := ORD(params[which][1]);
  204.            IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
  205.              BEGIN
  206.                FOR digitLoc := 1 TO Length(params[which]) DO
  207.                  intStr := Concat(intStr, GetDigit(params[which][digitLoc]),'');
  208.                GetInteger := intStr;
  209.                  exit(GetInteger);
  210.              END;
  211.          END;
  212.        GetInteger := intStr;    { just in case }
  213.      END;
  214.  
  215.    BEGIN
  216.      OpenSerial;
  217.      IF err <> 0 THEN 
  218.        BEGIN
  219.          SysBeep(1);
  220.          Fail('Could not open serial port');
  221.        END;
  222.      
  223.      GetMessage;
  224.      
  225.      { set flags }
  226.      reverseFlag := Contains('rev');
  227.      offFlag := Contains('off');
  228.      tillFlag := Contains('till');
  229.      
  230.      IF Contains('stop') THEN SendCommand('*')
  231.      ELSE IF Contains('eject') THEN SendCommand('\')
  232.      ELSE IF Contains('search') THEN SendCommand(Concat('+:', GetInteger, 'A'))
  233.      ELSE IF Contains('step') THEN
  234.        BEGIN
  235.          IF NOT reverseFlag THEN SendCommand('$')        {step fwd}
  236.          ELSE SendCommand(')')                        {step rev}
  237.        END
  238.      ELSE IF Contains('play') THEN
  239.        BEGIN
  240.          IF NOT tillFlag THEN
  241.              BEGIN
  242.                 IF NOT reverseFlag THEN SendCommand('%')    {play fwd}
  243.                  ELSE SendCommand('B');                         {play rev}
  244.             END
  245.          ELSE
  246.            BEGIN
  247.              CloseSerial;                                    {play till}
  248.              Fail('Use SendSerial for play till for now');
  249.            END;
  250.        END
  251.      ELSE IF Contains('slow') THEN
  252.        BEGIN
  253.          IF NOT reverseFlag THEN SendCommand('#')        {slow fwd}
  254.          ELSE SendCommand('(')                            {slow rev}
  255.        END
  256.      ELSE IF Contains('fast') THEN
  257.        BEGIN
  258.          IF NOT reverseFlag THEN SendCommand('!')            {fast fwd}
  259.          ELSE SendCommand('&')                                {fast rev}
  260.        END
  261.      ELSE IF Contains('scan') THEN
  262.        BEGIN
  263.          IF NOT reverseFlag THEN SendCommand('"')            {scan fwd}
  264.          ELSE SendCommand('''')                                {scan rev}
  265.        END
  266.      ELSE IF Contains('picture') THEN
  267.        BEGIN
  268.          IF NOT offFlag THEN SendCommand('n')                {picture on}
  269.          ELSE SendCommand('o')                                {picture off}
  270.        END
  271.      ELSE IF Contains('frame') THEN
  272.        BEGIN
  273.          IF NOT offFlag THEN SendCommand('L')                {frame on}
  274.          ELSE SendCommand('M')                                {frame off}
  275.        END
  276.      ELSE IF Contains('sound') THEN 
  277.        BEGIN
  278.          IF Contains('1') THEN
  279.            IF NOT offFlag THEN SendCommand('H')            {sound 1 on}
  280.            ELSE SendCommand('I')                        {sound 1 off}
  281.          ELSE IF Contains('2') THEN
  282.            IF NOT offFlag THEN SendCommand('J')            {sound 2 on}
  283.            ELSE SendCommand('K')                        {sound 2 off}
  284.          ELSE
  285.            BEGIN
  286.              CloseSerial;
  287.              Fail('Unknown video sound channel');
  288.            END;
  289.        END
  290.      ELSE IF Contains('init') THEN SendCommand('h')        
  291.      ELSE
  292.          BEGIN
  293.           CloseSerial;
  294.           SysBeep(1); 
  295.           Fail('Unknown video command');
  296.         END;
  297.      CloseSerial;
  298.    END;   
  299.  
  300. END.
  301.  
  302.  
  303.  
  304.